#asteriskQuestServer.tcl

package require base64

proc init { } {
  global CONFIG
  text .txtLog -font {Courier 10}
  place .txtLog -x 0 -y 0 -relwidth 1.0 -relheight 1.0
  wm geometry . "800x400"

  log "Welcome to asteriskQuestServer"

  set CONFIG(usersPath) ./users
  set CONFIG(worldsPath) ./worlds
  set CONFIG(tilesPath) ./tiles
  set CONFIG(npcsPath) ./npcs

  openServerListener 51413
}

proc log { msg } {
  if {[.txtLog count 0.0 end] > 10000} {
    set newText [string range [.txtLog get 0.0 end] 8000 end]
    .txtLog delete 0.0 end
    .txtLog insert 0.0 $newText
  }
  .txtLog insert end "$msg\n"
  .txtLog see end
  update; update idletasks
}

proc randomInt {min max} {
  return [expr {int(rand() * (1 + $max - $min)) + $min}]
}

proc openServerListener { portNum } {
  set serverSock [socket -server "openServerInstance $portNum" $portNum]
  log "Listening on port $portNum"
}

set serverInstances {}
proc openServerInstance { dstPortNum s srcAddr srcPortNum } {
  global serverInstances socketInfo

  log "Connection on $s from $srcAddr : $srcPortNum => $dstPortNum"
  lappend serverInstances $s
  fconfigure $s -blocking 0 -buffering line -translation binary

  set socketInfo($s,state) unauthenticated

  puts $s "asteriskQuestServer 0.1"

  fileevent $s readable "readSocket $s"

}

proc readSocket { s } {
  fileevent $s readable ""
  if {[gets $s line] < 0} {
    if {[eof $s]} {
      closeSocket $s
    }
  } else {
    handleCommand $s $line
    fileevent $s readable "readSocket $s"
  }
}

proc closeSocket { s } {
  log "Closing $s"
  close $s
}

proc authenticateUser {username password} {
  array set auth {john abcd rachel 1234}
  if {[info exists auth($username)] && [string match $password $auth($username)]} {
    return 1
  } else {
    return 0
  }
}

proc handleCommand { s line } {
  global socketInfo
  switch -exact -- $socketInfo($s,state) {
    echo {
      log "$s: ECHO \"$line\""
      puts $s "ECHO: \"$line\""
    }
    unauthenticated {
      #response should be "LOGIN <username> <password>"
      foreach {cmd username password} [split $line " "] {break}
      if {[string equal $cmd "LOGIN"]} {
        if {[authenticateUser $username $password]} {
          puts $s "OK: Login success. Initial state should follow"
          log "LOGIN success $username"

          loadUser $username $s

          set socketInfo($s,state) main

          #sendInitialState $s
        } else {
          puts $s "ERROR: Invalid username/password"
          log "LOGIN failure $username"
        }
      } else {
        puts $s "ERROR: User is unauthenticated. Must LOGIN first"
      }
    }
    main {

    }
    default {
      log "$s sent \"$line\" while in invalid state $socketInfo($s,state)"
    }
  }
}

  #this is the format of the data:
  #updateData=object+
  #object=tile|fullMap|mapUpdate|player|npc|message
  #tile=TILE tileID bitmap
  #tileID=integer
  #bitmap=bitmaprow*tileWidth
  #bitmaprow={color*tileHeight}
  #color=#3byteHexColor
  #fullMap=FULLMAP mapName tileData obstructionData
  #mapName=string
  #tileData={mapRow*height}
  #mapRow=tileID*width
  #obstructionData={obstructionRow*height}
  #obstructionRow=boolean*width
  #booleanObstruction=0|1
  #mapUpdate=MAPUPDATE updateX updateY tileID booleanObstruction
  #updateX=integer
  #updateY=integer
  #player=PLAYER tileID playerX playerY playerName playerDirection playerStats itemList
  #playerName=string
  #playerX=float
  #playerY=float
  #playerDirection=N|S|E|W
  #playerStats=!!<list of TBD>!!
  #itemList=item+
  #item=itemType itemStrength itemName itemDescription
  #itemType=WEAPON|RING|POTION|etc..
  #itemStrength=float
  #itemName=string
  #itemDescription=string
  #npc=NPC tileID npcX npcY npcStats npcType npcName npcDescription
  #npcX=float
  #npcY=float
  #npcStats=!!<list of TBD>!!
  #npcType=string
  #npcName=string
  #npcDescription=string
  #message=MESSAGE msgType msgString
  #msgType=string
  #msgString=string

proc makeSolidTile { id color size } {
  set tileData {}
  for {set i 0} {$i < $size} {incr i} {
    lappend tileData [lrepeat $size $color]
  }
  return "{TILE $id [list $tileData]}"
}

proc sendInitialState { s } {
  puts -nonewline $s "{NPC 3 5.2 5.2 {{HP 5 10} {MP 0 0} {STR 2} {INT 0}} CRAB CRAB1 {Red Crab}} "
  puts -nonewline $s "{NPC 3 2.5 2.5 {{HP 4 10} {MP 0 0} {STR 2} {INT 0}} CRAB CRAB2 {Red Crab}} "
  puts $s ""
}

proc loadUser {username s} {
  global USERS CONFIG
  log "Loading user $username"
  if {![info exists USERS($username,loaded)]} {
    set fd [open [file join $CONFIG(usersPath) ${username}.dat] "r"]
    set data [read $fd]
    close $fd
    array set USERS $data
  }
  #now we need to load any world data that is related to this user
  loadWorld $USERS($username,world) $s
  #now we need to load any tiles that are related to this user
  loadTile $USERS($username,tileID) $s

  puts $s "{PLAYER {$USERS($username,tileID)} $USERS($username,x) $USERS($username,y) S {$USERS($username,stats)} {$USERS($username,items)}}"
}

proc loadWorld {worldName s} {
  global WORLDS CONFIG
  log "Loading world $worldName"
  if {![info exists WORLDS($worldName,loaded)]} {
    set fd [open [file join $CONFIG(worldsPath) ${worldName}.dat] "r"]
    set data [read $fd]
    close $fd
    array set WORLDS $data

  }
  #now we need to load any tiles that the world needs
  foreach tileID $WORLDS($worldName,tiles) {
    loadTile $tileID $s
  }

  foreach npcName $WORLDS($worldName,npcs) {
    loadNPC $npcName
  }

  puts $s "{FULLMAP {$WORLDS($worldName,name)} {$WORLDS($worldName,tileMap)} {$WORLDS($worldName,obstructionMap)}}"
}

proc loadTile {tileName s} {
  global TILES CONFIG
  log "Loading tile $tileName"
  if {![info exists TILES($tileName,loaded)]} {
    set fd [open [file join $CONFIG(tilesPath) ${tileName}.gif] "rb"]
    set data [read $fd]
    set TILES($tileName) [::base64::encode -maxlen 0 $data]
  }
  puts $s "{TILE {$tileName} $TILES($tileName)}"
}

proc loadNPC {npcName} {
  global CONFIG NPCS
  log "Loading NPC $npcName"
  if {![info exists NPCS($npcName,loaded)]} {
    set cmd "source \"[file join $CONFIG(npcsPath) ${npcName}.tcl]\""
    uplevel #0 $cmd
  }
}

proc eventLoop { }  {
  global WORLDS USERS
  log "Event Loop"
  set activeWorlds {}
  foreach {userLoaded world} [array get USERS *,world] {
    lappend activeWorlds $world
  }
  set activeWorlds [lsort -unique $activeWorlds]
  log "Active worlds = $activeWorlds"
  foreach world $activeWorlds {
    #add missing NPCs
    foreach npcArea $WORLDS($world,npcAreas) {
      foreach {areaSettings areaNPCs} $npcArea {break}
      foreach {x1 y1 x2 y2 npcType maxCount rate} $areaSettings {break}
      set currentCount [llength $areaNPCs]
      #only adding 1 npc even if more are missing
      if {$currentCount < $maxCount} {
        if {[randomInt 1 $rate] == 1} {
          set newX [randomInt $x1 $x2]
          set newY [randomInt $y1 $y2]
          #not checking if there's already a NPC at this spot
          log "Spawing a new $npcType @ $newX $newY in $world"
          set npc [npcNew${npcType} $newX $newY]
          #now we have to send this data to all users in this world
          #now we have to save this data to the world
        }
      }
    }
  }
  after 1000 eventLoop
}

init
eventLoop
